Night Owl 6/Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso/037a/wedits22.zip/WWIVEDIT.PAS

Pascal/Delphi Source File | 1991-08-19 | 30KB | 1,138 lines

{$M 16000,0,655360}
PROGRAM WWIVEdit(Input,Output);
(******************************************************************************
 **                                                                          **
 **                             WWIVEdit Version 2.2                         **
 **                            Last Modified : 8/19/91                       **
 **                        By Adam Caldwell (The Emporer)                    **
 **               1@ 16401 (Link) [The First Galactic Empire (Link)]         **
 **               1@  6470 (Net)  [The First Galactic Empire (Net) ]         **
 **             718@  5252 (Net)  [Dragon's Den (Net)              ]         **
 **                      Phone: [phone] [ Link BBS ]                  **
 **                                                                          **
 ** Purpose : WWIV is a full screen editor designed specifically for use with**
 ** the WWIV 4.xx BBS system.  It takes advantage of many of the features    **
 ** features of WWIV such as colors, Macros, and WWIV specific formatting    **
 ** functions.                                                               **
 ** It is a Word Processor like editor that I have written to be             **
 ** easily Extendable (if you understand my programming style :-)            **
 **                                                                          **
 ** This source code is Limited Public Domain.  By this I mean that you may  **
 ** freely modify and distribute this source code so long as:                **
 **    1) No Fee is charged for this or any product derived from this code   **
 **    2) Any modifications that you make are CLEARLY noted as not being     **
 **       my code (ie, initial it) if you distrubute modified versions       **
 **    3) You don't change this message header in any way [including removal **
 **       of it]                                                             **
 **    4) No NOT use the naming convention WEDITSxx.ZIP when distributing it **
 **       This is reserved for *official* releases                           **
 **                                                                          **
 ******************************************************************************)

{{$DEFINE DEBUG}       { Remove first comment symbol to make actually define it }
{{$DEFINE DIRECTVIDEO} { Don't define either of these for the BBS }
{$DEFINE OVERLAY}      { UnDefine if you don't want overlays }
{$DEFINE VERSION_2_2}  { Doesn't do anything... Just there so you know what version it is }

{$IFDEF DEBUG}
{$R+,V+,S+,B-,E-,N-}   { These were used to find a bunch of little bugs :-)  }
{$ELSE}
{$R-,V-,S-,B-,E-,N-}   { These Optomize things as much as possible }
{$ENDIF}

USES DOS, WEMisc,WEVars, WEDict, WEKbd, WETime, WEString,
     WELine, WEOutput, WEChat, WEInit, WEInput, WETag{, WEDefaul}

{$IFDEF OVERLAY}
     ,Overlay
{$ENDIF}

{$IFDEF DIRECTVIDEO} {-- This unit uses the CRT unit.  I wrote this because I needed}
     ,WWIVOutp       {-- to debug this code on a system without an ANSI driver.}
{$ENDIF};            {-- It is also used to "simulate" 12/2400 bps modems... Available upon request }

{$IFDEF OVERLAY}
  {$O WEChat}
  {$O WEDict}
  {$O WEInit}
  {$O WETag}
  {$O WEMisc}
  {{$O WEDefaul}   { ** Future Enhancement ** }
{$ENDIF}

PROCEDURE ScrollWindowDown;
{ Moves the viewport down on the Text Buffer }
VAR x:integer;
BEGIN
  IF cy>MaxLines THEN cy:=MaxLines-1;
  x:=cy-ViewTop;
  cy:=cy+WindowHeight-MinScrollLeft;
  ViewTop:=cy-x;
  ViewBottom:=ViewTop + WindowHeight;
  IF viewBottom>MaxLines THEN BEGIN
    ViewBottom:=MaxLines-1;
    ViewTop:=ViewTop-WindowHeight;
    cy:=ViewBottom;
  END;
END;



PROCEDURE ScrollWindowUp;
VAR x:integer;
{ Moves the Viewport Up on the Text Buffer }
BEGIN
  IF cy<1 THEN cy:=1;
  x:=cy-ViewTop;
  cy:=cy-WindowHeight+MinScrollLeft;
  ViewTop:=cy-x;
  ViewBottom:=ViewTop+WindowHeight;
  IF ViewTop<1 THEN BEGIN
    ViewTop:=1;
    cy:=1;
    ViewBottom:=ViewTop + WindowHeight;
  END;
END;




FUNCTION Done(VAR Cmd:EdFun):boolean;
{ Asks whether or not user wants to save, Abort, or Resume, and handles
  calls to EditTagline }
VAR
  ch:char;
  OkSet : CharSet;
  TagS:string;
  TagCh:string;
BEGIN
  Ansic('0');
  OkSet:=['A','S','R','D',ESC];
  IF NOT (Cmd IN [AbortPost,QuietExitAndSave]) THEN
  BEGIN
    IF OkTagLines THEN BEGIN
      TagS:=', '+C1+'T'+C2+'aglines';
      OkSet:=OkSet+['T'];
      TagCh:='T'
    END ELSE BEGIN
      TagS:='';
      TagCh:=''
    END;
    StatusLine3(C1+'A'+C2+'bort, '+C1+'S'+C2+'ave, '+C1+'R'+C2+'esume'+
                {C1+'D'+C2+'efaults'}+TagS+' [ASR'+TagCh+'] > '+C1);
    IF Cmd=ExitAndSave
      THEN ch:='S'
      ELSE ch:=ReadSet(OkSet);
    IF ch=#27 THEN ch:='R';
    ansic('0');
    IF ch='A' THEN
    BEGIN
      gotoxy(6,WindowBottom+1);
      clreol;
      prompt('   '+C6+'Are you sure?'+C2+' [yN] '+C1);
      ch:=ReadSet(['Y','N',ENTERKey,ESC]);
      IF ch <>'Y'
        THEN ch:='R'
        ELSE ch:='A'
    END;
    IF ch='R' THEN
    BEGIN
      StatusLine3('');
      ShowMaxLines
    END
    ELSE IF Ch='T' THEN
    BEGIN
      EditTaglines;
      ForcedRedisplay;
    END {
    ELSE IF ch='D' THEN
    BEGIN
      EditDefaults;
      ForcedRedisplay;
    END};
    Done:=ch IN ['S','A'];
    IF ch ='A' THEN nl;
    IF ch='S' THEN cmd:=ExitAndSave;
  END;
END;





{$F+}
VAR lx,ly:integer;
PROCEDURE ShowWhere;
{ Procedure Called by GetKey (as the BeforeNext procedure) to display the
  cursor position.  It must be activated (by ^KW) }
VAR x,y:byte;
BEGIN
  IF (lx<>cx) OR (ly<>cy) THEN
  BEGIN
    IF Local THEN writescreen(cstr(cx)+':'+cstr(cy)+'  ',1,ScreenHeight-3,7)
    ELSE
    BEGIN
      x:=wherex; y:=wherey;
      statusline3(c0+cstr(cx)+':'+cstr(cy));
      Gotoxy(x,y);
    END;
  END;
  lx:=cx; ly:=cy;
END;
{$F-}

PROCEDURE DoToggleWhere;
{ Installs/uninstalls The ShowWhere procedure into the BeforeNext procedure }
BEGIN
  IF @BeforeNext=@DoNothing THEN
  BEGIN
    BeforeNext:=ShowWhere;
    lx:=-1;
  END
  ELSE BEGIN
    BeforeNext:=DoNothing;
    StatusLine3(C0);
  END;
END;


PROCEDURE Help;
{ Prints out the Help file and then causes a redisplay afterward }
  PROCEDURE GotoP(x:integer);
  BEGIN
    gotoxy(20*((x-1) mod 4)+1,((x-1) div 4) +2);
  END;
VAR
  ch:char;
  x:integer;
  top : integer;
  s,topic : string;
  fun : EdFun;
  t:text;
  topics : array[1..80] OF String[20];
  nfound : integer;
BEGIN
  ansic('0');
  assign(t,StartupDir+'WWIVEDIT.HLP');
  topic:='';
  nfound := 0;
  {$I-} reset(t); {$I+}
  IF IOResult=0 THEN
  BEGIN
    REPEAT
      readln(t,s);
    UNTIL s='START';
    REPEAT
      readln(t,s);
      IF s<>'END' THEN BEGIN
        inc(nfound);
        topics[nfound]:=s;
      END;
    UNTIL s='END';
    IF Local THEN
    BEGIN
      REPEAT
        readln(t,s);
      UNTIL s='LOCAL';
      REPEAT
        readln(t,s);
        IF s<>'END' THEN BEGIN
          inc(nfound);
          Topics[nfound]:=s;
        END;
      UNTIL s='END'
    END;
  END;
  top:=1;
  IF Nfound<>0 THEN
  REPEAT
    clrscr;
    Print(C5+'Available Help Topics: '+C2+'['+c1+'Press '+C5+'ESC'+C1+' to Exit, or '+
          C5+'ENTER'+C1+' to Choose Topic'+C2+']');
    FOR x:=1 TO Nfound DO
    BEGIN
      GotoP(x);
      IF x=top
        THEN ansic('4')
        ELSE ansic('0');
      prompt(Topics[x]);
    END;
    GotoP(top);
    REPEAT
      fun:=GetArrow;;
      IF fun IN [Up,Down,Left,Right] THEN
      BEGIN
        ansic('0');
        write(Topics[Top]);
        CASE fun OF
          Up   : Dec(Top,4);
          Down : Inc(Top,4);
          Left : Dec(Top);
          Right: Inc(Top);
        END;
        IF Top<1 THEN Top:=Top+NFound
        ELSE IF Top>NFound THEN Top:=Top-NFound;
        GotoP(top);
        ansic('4');
        write(Topics[Top]);
        GotoP(top);
      END;
    UNTIL Fun IN [Enter,NormalExit];
    IF fun=NormalExit
      THEN Topic:=''
      ELSE Topic:=Topics[Top];
    IF Fun=GetHelp THEN Topic:='HELP ON HELP';
    Topic:=TransformString(Topic);
    IF Topic<>'' THEN BEGIN
      reset(t);
      gotoxy(1,22);
      prompt(C2+'Searching...');
      REPEAT
        readln(t,s);
      UNTIL (s='EOF') OR (s=Topic+':') OR ((s=Topic+';') AND Local);
      IF s='EOF' THEN print(C6+'Topic Not Found'+C0)
      ELSE BEGIN
        REPEAT
          readln(t,s);
        UNTIL s='SOT';
        clrscr;
        print(c7+'Topic '+c3+': '+c1+Topic);
        REPEAT
          readln(t,s);
          IF s[length(s)]=^A THEN delete(s,length(s),1);
          IF s[length(s)]=' ' THEN delete(s,length(s),1);
          IF s='.P' THEN BEGIN
            PauseScr;
            ClrScr;
          END
          ELSE IF cmpleft(s,^B) THEN Center(RightS(s,Length(s)-1))
          ELSE IF s<>'EOT' THEN
            print(C0+s);
        UNTIL (s='EOT') OR CheckAbort;
      END;
      close(t);
    END;
  UNTIL topic=''
  ELSE BEGIN
    print(c6+'Help file not found!'+c0);
    prompt(c3+'Press any key to return to the editor.'+c0);
    ch:=GetKey;
  END;
  ForcedRedisplay;
END;


PROCEDURE ForceDone;
{ Yell at the user for going over line limit }
BEGIN
  StatusLine1(c6+'No More Lines Left.'+chr(7)+c0);
END;



PROCEDURE ReadInputFile(lines:integer; FileName:String);
{ Reads in an input file at the given line number }
VAR t:text;
  ccol:integer;
  ch:char;
  i:integer;
  CurColor:char;
  s:string;
  f:file of byte;
  BytesRead:LongInt;
  Step : LongInt;
  printed : integer;
BEGIN
  assign(t,Filename);
  {$I-} reset(t); {$I+}
  IF IOResult=0 THEN
  BEGIN
    BytesRead:=0;
    assign(f,Filename);
    reset(f);
    Step := FileSize(f) DIV 20;
    close(f);
    curcolor:='0';
    ccol:=1;
    prompt(C2+'Loading File '+C3+': '+C0+dup('░',20)+ESC+'[20D');
    Printed:=0;
    ansic('1');
    WHILE (NOT EOF(t)) AND (Lines<MaxLines) DO
    BEGIN
      Drain;
      readln(t,s);
      BytesRead:=BytesRead+Length(s)+1;
      WHILE BytesRead DIV Step >= Printed DO
      BEGIN
        write('█');
        inc(Printed);
      END;
      inc(lines);
      ccol:=1;
      CurColor:='0';
      IF (s[length(s)]=^A) AND (s[length(s)-1]=' ') THEN
        delete(s,length(s)-1,1);
      WHILE s<>'' DO
        IF NOT (s[1] IN [^A,^B,^C]) THEN
        BEGIN
          IF ccol>LineLen THEN BEGIN
            inc(Lines);
            Line[lines]^.HardCR:=False;
            ccol:=1;
          END;
          Line[lines]^.l:=Line[lines]^.l+s[1];
          Line[Lines]^.c:=Line[Lines]^.c+CurColor;
          delete(s,1,1);
          inc(ccol);
        END
        ELSE BEGIN
          IF s[1]=^B THEN
          BEGIN
            IF ccol<>1 THEN BEGIN
              Line[Lines]^.HardCr:=TRUE;
              ccol:=1;
              inc(Lines);
            END;
            Line[Lines]^.l:='/C:';
            Line[Lines]^.c:='000';
            delete(s,1,1);
          END
          ELSE IF s[1]=^C THEN
          BEGIN
            CurColor:=s[2];
            delete(s,1,2);
          END ELSE IF s[1]=^A THEN
          BEGIN
            Line[Lines]^.HardCR:=FALSE;
            delete(s,1,1);
          END;
        END;
    END;
    close(t);
    ansic('0');
  END;
  HighLine:=Lines;
END;

FUNCTION CheckDest:boolean;
VAR
  t:text;
  s:string;
  ok, NeedOK:boolean;
BEGIN
  ok:=TRUE;
  NeedOK:=false;
  Assign(t,StartUpDir+'NOTAG');
  {$I-} reset(t); {$I+}
  IF IOResult=0 THEN
  BEGIN
    WHILE (NOT EOF(t)) AND OK DO
    BEGIN
      Readln(t,s);
      IF s[1]='"' THEN BEGIN
        Delete(s,1,1);
        Delete(s,length(s),1)
      END;
      IF pos(s,Destination)>0 THEN ok:=FALSE;
    END;
    close(t);
  END;
  CheckDest:=OK;
END;

PROCEDURE WriteOutputFile(VAR ReturnCode:integer);
{ Writes output file... could use some color optimizations }
VAR
  t, t1:text;
  l,x,i:integer;
  ch:char;
  ccol : integer;
  curcolor : char;
  plural:string[1];
  ignore : integer;
  s,s1:string;
  BBSTag:Text;
  dummy : integer;
  sr : SearchRec;
  Nfound : integer;
BEGIN
  dummy:=returncode;
  nfound :=0;
  assign(t,Filename);
  l:=MaxLines;
  WHILE (l>0) AND (Line[l]^.l='') DO
    dec(l);
  s:=TransformString(Line[l]^.L);
  IF (length(s)>2) AND (s='/ES') THEN
     Delete(s,2,1);  { Remove the E }
  IF s='/SN' THEN ReturnCode := NonAnonymousReturnCode
  ELSE IF s='/SY' THEN ReturnCode := AnonymousReturnCode
  ELSE ReturnCode:=NormalReturnCode;
  IF cmpLeft(s,'/S') THEN dec(l);
  IF l>1
    THEN plural:='s'
    ELSE plural:='';
  IF l>0 THEN
  BEGIN
    nl;
    s:=C7+'Saving '+C1+cstr(l)+C7+' line'+plural+'... '+C0;
    IF OKTaglines
      THEN OkTaglines:=OKTaglines AND CheckDest;
    IF dummy=0
      THEN prompt(s)
      ELSE StatusLine3(s);
    clreol;
    CurColor:='0';
    ignore:=0;
    rewrite(t);
    FOR x:=1 TO l DO
    BEGIN
      CurColor:='0';
      s1:=Line[x]^.l;
      s:=TransformString(s1);
      IF (length(s)>1) AND (s[1]='/') THEN
      BEGIN
        IF cmpLeft(s,'/ES') OR cmpLeft(s,'/S') THEN
        BEGIN
          Line[x]^.l:='';
          s1:='';
        END
        ELSE IF cmpLeft(s,'/C:') THEN
        BEGIN
          Delete(Line[x]^.c,1,3);
          Insert('000',Line[x]^.c,1);
        END;
      END;
      ccol:=1;
      FOR i:=1 TO length(s1) DO
        IF Color(Line[x]^,i)<>CurColor THEN
        BEGIN
          CurColor:=Color(Line[x]^,i);
          insert(^C+CurColor,s1,ccol);
          inc(ccol,3);
        END ELSE inc(ccol);
      IF cmpLefti(s1,'/C:') THEN
      BEGIN
        delete(s1,1,3);
        insert(^B,s1,1);
      END;
{      IF NOT (Line[x]^.HardCR) AND (s1[length(s1)]<>' ') THEN
        s1:=s1+' ';}
      IF Line[x]^.HardCR
        THEN writeln(t,s1)
        ELSE writeln(t,s1+^A);
    END;
    IF curColor<>'0' THEN write(t,C0);
    IF info.selected>3 THEN
    BEGIN
      info.selected:=3;
      WHILE (info.selected>0) AND (info.Tagline[info.selected]<>'') DO
        dec(info.selected);
    END;
    IF OkTagLines AND NOT FileThere AND
       (info.selected>0) AND
       (info.method<>0) AND (info.method<>6) AND
       (info.Tagline[info.selected]<>'') AND
       (ReturnCode <> AnonymousReturnCode)  THEN
    BEGIN
      prompt(C2+'Writing Personal Tag Line... '+C0);
      FindFirst(StartupDir+'WWIVEDIT.DIV',0,sr);
      IF DOSError<>0 THEN
        writeln(t,'-----')
      ELSE BEGIN
        assign(t1,StartUpDir+'WWIVEDIT.DIV');
        reset(t1);
        readln(t1,s);
        writeln(t,s);
        close(t1);
      END;
      ccol:=1;
      WHILE ccol<length(info.Tagline[1])-3 DO
      BEGIN
        IF copy(TransformString(info.Tagline[1]),ccol,3)='/C:' THEN
        BEGIN
          delete(info.Tagline[1],ccol,3);
          insert(^B,info.Tagline[1],ccol);
        END;
        inc(ccol);
      END;
      ccol:=1;
      FOR i:=1 TO Length(info.Tagline[info.selected]) DO
      WITH info DO
      BEGIN
        IF TagLine[selected][i]=^M THEN
        BEGIN
          writeln(t);
          ccol:=1;
        END
        ELSE IF TagLine[selected][i]=^N THEN
        BEGIN
          write(t,^H);
          dec(ccol)
        END
        ELSE IF TagLine[selected][i] IN [^P,^C] THEN
        BEGIN
          write(t,^C);
          CurColor:=TagLine[selected][i+1];
          dec(ccol,1);
        END ELSE IF TagLine[selected][i] IN [^B,#32..#255]-[#127] THEN
        BEGIN
          write(t,TagLine[selected][i]);
          inc(ccol)
        END
      END;
      IF ccol<>1 THEN writeln(t);
    END;
    IF AddBBSTag AND (NOT FileThere) AND CheckDest THEN
    BEGIN
      prompt(c5+'Writing BBS tagline... '+c0);
      findfirst(StartupDir+'BBS*.TAG', 0, sr);
      WHILE DOSError=0 DO
      BEGIN
        inc(nfound);
        FindNext(sr);
      END;
      nfound:=random(nfound)+1;
      findfirst(StartupDir+'BBS*.TAG', 0, sr);
      dec(nfound);
      WHILE nfound>0 DO
      BEGIN
        dec(nfound);
        FindNext(sr);
      END;
      writeln(t);
      assign(bbstag,StartupDir+sr.name);
      reset(bbstag);
      WHILE not EOF(bbsTag) DO
      BEGIN
        read(bbsTag,ch);
        write(t,ch)
      END;
      close(bbstag);
    END;
    close(t);
  END;
  IF dummy<>0 THEN statusline3(C0);
  IF (l=0) AND FileThere THEN BEGIN
    nl;
    clreol;
    print(c2+'File erased'+C0);
    erase(t);
  END
  ELSE IF l=0 THEN
  BEGIN
    nl;
    clreol;
    Print(c0+'Aborted');
  END;
END;


PROCEDURE DoBackspace;
{ All this just because the user hits the Backspace (or Delete) }
VAR
  temp:LineType;
  Ins:boolean;
BEGIN
  Ins:=InsertMode;                { Save the current InsertMode State }
  InsertMode:=True;               { Set insert mode on }
  IF cx > 1 THEN BEGIN            { If we aren't in the first column, things are easy }
    LDelete(cy,cx-1,1);           { Just delete the character to the left of }
    dec(cx);                      { the cursor and back up }
    reformat(cy,false);
  END
  ELSE IF len(cy)=0 THEN BEGIN    { Special case for if there isn't anything }
    DeleteLine(cy);               { On the line we are backspacing from }
    dec(cy);
    cx:=Len(cy)+1;
  END
  ELSE IF cy>1 THEN BEGIN         { Otherwise, the user wants to join two lines }
    dec(cy);                      { Back up one line }
    cx:=len(cy)+1;                { move to the end of it }
    IF (cx=1) THEN
      DeleteLine(cy)
    ELSE BEGIN
      Line[cy]^.hardCR:=false;
      Reformat(cy,false);         { Reformat everything now to shorten the line }
    END;
  END;
  InsertMode:=Ins;                { Go back to current insert state }
END;




PROCEDURE DoCenterLine(VAR cy:integer);
{ Places the centering code at the beginning of the line }
VAR
  Space:LineType;
  ins : boolean;
BEGIN
  Ins:=InsertMode;
  InsertMode:=true;
  Space.l:='/C:';
  Space.c:='000';

  IF (Len(cy)>0) AND (Len(cy)<LineLen-3) THEN
    LInsert(Space,cy,1);

  cx:=1;
  IF cy<MaxLines THEN inc(cy);
  InsertMode:=ins;
END;



PROCEDURE ShowBlockStatus;
BEGIN
  StatusLine3('Block Begin Line '+cstr(BlockStart)+', Block Ending Line '+cstr(BlockEnd));
  AfterNext:=ClrStatLine3;
END;


PROCEDURE DoDeleteBlock(startline,endline:integer);
VAR
  i:integer;
BEGIN
  IF EndLine>=StartLine THEN
  FOR i:=0 TO endline-startline DO
    DeleteLine(Startline);
END;

PROCEDURE DoBlockCopy(VAR startline,endline:integer; toline:integer);
VAR
  x:integer;
  o : integer;
  i : integer;
BEGIN
  IF (ToLine+EndLine-StartLine<MaxLines) AND (startline>0) AND
     (startline<=endline) AND ((toline>endline) OR (toline<=startline)) THEN
  FOR i:=0 TO EndLine-StartLine DO
  BEGIN
    InsertLine(toline,Line[i+StartLine]^);
    inc(toline);
  END;
END;

PROCEDURE DoBlockMove(VAR BlockStart,BlockEnd:integer; ToLine:integer);
VAR x:integer;
BEGIN
  x:=BlockStart;
  IF ToLine>BlockStart
    THEN x:=ToLine-BlockEnd+BlockStart-1
    ELSE x:=ToLine;
  DoBlockCopy(BlockStart,BlockEnd,ToLine);
  DoDeleteBlock(BlockStart,BlockEnd);
  BlockEnd:=x+BlockEnd-BlockStart;
  BlockStart:=x;
  ShowBlockStatus;
END;

PROCEDURE DoInsertFile;
{ Prompt for a file name and then read it in at the end of the current
  Text Buffer }
VAR
  s : string;
BEGIN
  StatusLine3(C2+'File Name read in > '+C1);
  readln(s);
  StatusLine3(C0);
  IF s<>'' THEN ReadInputFile(HighLine,s);
  StatusLine3('');
  ShowHeader;
END;


PROCEDURE PrintOutput;
{ Prints the current text buffer to the screen }
VAR
  i, j, s : integer;
  ccol : char;

BEGIN
  clrscr;
  ccol:='0';
  ansic(ccol);
  print(title);
  i:=0;
  WHILE i < Highline DO
  BEGIN
    inc(i);
    IF cmpLeftI(Line[i]^.l,'/C:') THEN
      Center(RightS(Line[i]^.l,len(i)-3))
    ELSE
    FOR j:=1 TO Len(i) DO
    BEGIN
      IF Line[i]^.c[j]<>ccol THEN BEGIN
        ccol:=Line[i]^.c[j];
        ansic(ccol);
      END;
      prompt(Line[i]^.l[j]);
    END;
    IF checkAbort THEN i:=HighLine;
    writeln;
    ccol:='0';
    ansic('0');
  END;
  pausescr;
  ForcedRedisplay;
END;


PROCEDURE DoSaveAndContinue;
VAR dummy:integer;
BEGIN
  dummy:=-1;
  WriteOutputFile(dummy);
END;

PROCEDURE DoEnter;
BEGIN
  IF cx<=Len(cy) THEN
  BEGIN
    Line[0]^.l:=copy(Line[cy]^.l,cx,len(cy)-cx+1);
    Line[0]^.c:=copy(Line[cy]^.c,cx,len(cy)-cx+1);
    LDelete(cy,cx,len(cy)-cx+1);
    inc(cy);
    InsertLine(cy,Line[0]^);
    InitLine(Line[0]^);
    cx:=1;
    Line[cy]^.HardCR:=Line[cy-1]^.hardCR;
    Reformat(cy,false);
  END
  ELSE BEGIN
    inc(cy);
    cx:=1;
    InitLine(Line[0]^);
    InsertLine(cy,Line[0]^);
  END;
  Line[cy-1]^.HardCR := TRUE;
END;


PROCEDURE DoDelChar;
BEGIN
  inc(cx);
  IF cx>Len(cy)+1 THEN
  BEGIN
    dec(cx);
    IF Len(cy+1)=0 THEN
      DeleteLine(cy+1)
    ELSE BEGIN
      Line[cy]^.HardCR:=False;
      Reformat(cy,false);
    END;
  END
  ELSE DoBackspace;
END;

PROCEDURE DoTab;
VAR
  Temp : LineType;
BEGIN
  IF cx < LineLen - TabStop THEN
  REPEAT
    MakeString(temp,' ',CurrentColor);
    LInsert(Temp,cy,cx);
    Reformat(cy,False);
    inc(cx);
  UNTIL (cx-1) mod TabStop =0;
END;

PROCEDURE DoToggleScreen;
BEGIN
  IF ScreenState=0 THEN BEGIN
    ScreenState:=1;
    WindowTop:=1;
    WindowBottom:=ScreenHeight-3;
  END
  ELSE IF ScreenState=1 THEN BEGIN
    ScreenState:=2;
    WindowTop:=3;
  END
  ELSE BEGIN
    ScreenState:=0;
    WindowTop:=5;
    WindowBottom:=ScreenHeight-4;
  END;
  WindowHeight:=WindowBottom-WindowTop;
  ViewBottom:=ViewTop+WindowHeight;
  ForcedRedisplay;
END;

FUNCTION DoFun(fun:edfun; VAR ch:char):edfun;
BEGIN
  CASE fun OF
    BackSpace   : IF ((cy=1) AND (cx>1)) OR (cy>1) THEN
                    DoBackspace;
    Bottom      : cy:=highline+1;
    CenterLine  : DoCenterLine(cy);
    CopyBlock   : DoBlockCopy(BlockStart,BlockEnd,cy);
    DelChar     : DoDelChar;
    DelEOL      : LDelete(cy,cx,len(cy)-cx+1);
    DeleteBlock : BEGIN
                    cy:=BlockStart;
                    DoDeleteBlock(BlockStart,BlockEnd);
                  END;
    DelLine     : BEGIN cx:=1; DeleteLine(cy); END;
    DelSOL      : BEGIN
                    LDelete(cy,1,cx-1);
                    cx:=1;
                  END;
    Down        : IF cy<MaxLines THEN inc(cy);
    _end        : cx:=len(cy)+1;
    Enter       : DoEnter;
    EraseWordLeft:BEGIN
                    WHILE (cx>1) AND (character(cy,cx-1)=' ') DO
                      DoBackspace;
                    WHILE (cx>1) AND (character(cy,cx-1)<>' ') DO
                      DoBackspace;
                  END;
    Find        : DoSearch;
    FindLast    : SearchLast;
    GetHelp     : Help;
    GoBack      : BEGIN
                    fun:=InsertChar;
                    ch:=^H;
                  END;
    Home        : cx:=1;
    InsertFile  : DoInsertFile;
    InsLine     : insertLine(cy,Line[0]^);
    Jump        : DoJump;
    Left        : BEGIN
                    dec(cx);
                    IF (cx=0) AND (cy>1) THEN
                    BEGIN
                      cx:=len(cy-1)+1;
                      dec(cy)
                    END
                  END;
    MarkEnd     : BEGIN BlockEnd   := cy; ShowBlockStatus END;
    MarkStart   : BEGIN BlockStart := cy; ShowBlockStatus END;
    MoveBlock   : DoBlockMove(BlockStart,BlockEnd,cy);
    PgDn        : ScrollWindowDown;
    PgUp        : ScrollWindowUp;
    RedisplayAll: ForcedRedisplay;
    Right       : BEGIN
                    inc(cx);
                    IF cx>LineLen+1 THEN
                    BEGIN
                      inc(cy);
                      cx:=1
                    END;
                  END;
    SaveAndContinue: DoSaveAndContinue;
    ShowBlockStat:ShowBlockStatus;
    Tab         : DoTab;
    ToggleInsert: BEGIN InsertMode:=NOT InsertMode; ShowMaxLines; END;
    ToggleFullScreen : DoToggleScreen;
    ToggleWhere : DoToggleWhere;
    Top         : cy:=1;
    Up          : IF cy>1 THEN dec(cy);
    WordLeft    : Cx:=GoLeft(Line[cy]^.l,cx);
    WordRight   : cx:=GoRight(Line[cy]^.l,cx);
    WWIVColor   : BEGIN
                    ch:=GetKey;
                    IF MCICommands AND (ch IN ['g'..'z','G'..'Z']) THEN
                      fun:=InsertMCI
                    ELSE
                    IF colorRangeCheck THEN
                      IF Cmap[ch] THEN
                        CurrentColor:=ch
                      ELSE
                    ELSE CurrentColor:=ch;
                  END;
  END;
  DoFun:=Fun;
END;


PROCEDURE DoSlash(VAR fun : Edfun);
VAR
  s:string;
  dummy:char;
BEGIN
  s:=TransformString(Line[cy-1]^.l);
  IF s='/HELP' THEN
  BEGIN
    DeleteLine(cy-1);
    dec(cy);
    Help;
  END;
  IF s='/CLR' THEN
  BEGIN
    FOR cy:=1 TO MaxLines DO
      InitLine(Line[cy]^);
    cy:=1;
  END;
  IF s='/RL' THEN
  BEGIN
    dec(cy,2);
    DeleteLine(cy);
    DeleteLine(cy);
  END;
  IF s='/LI' THEN
  BEGIN
    dec(cy);
    DeleteLine(cy);
    PrintOutput;
  END;
  IF (s='/TI') AND AllowTitleChange THEN
  BEGIN
    dec(cy);
    DeleteLine(cy);
    gotoxy(9,1);
    ansic('1');
    clreol;
    input(s,60);
    IF s<>''
      THEN Title:=s
      ELSE BEGIN gotoxy(9,1); ansic('1'); prompt(title); END;
  END;
  IF (s='/CHECK') OR (s='SPELL') THEN BEGIN
    Dec(cy);
    DeleteLine(cy);
    SpellCheck;
  END;
  IF s='/RD' THEN BEGIN
    dec(cy);
    deleteLine(cy);
    Fun:=DoFun(RedisplayAll,dummy);
  END;
  IF (length(s)<=4) AND (cmpLeft(s,'/ES') OR cmpLeft(s,'/S')) THEN
    Fun:=QuietExitAndSave;
  IF s='/ABT' THEN Fun:=AbortPost;
END;



FUNCTION EditText:EdFun;
VAR
  ch :char;
  fun : edfun;
  temp : linetype;
  s : string;

BEGIN
  Highline:=MaxLines;
  WHILE (HighLine>0) AND (Len(HighLine)=0) DO
    dec(Highline);
  REPEAT
    IF (cy>HighLine) AND (Len(cy)>0) THEN
      HighLine:=cy;
    IF cy>MaxLines THEN BEGIN
      prompt(^G);
      cy:=MaxLines;
    END;
    IF highline+1=MaxLines THEN
      StatusLine3(c6+'One Line Left!'+c0);
    IF highline=MaxLines THEN
      ForceDone;

    fun:=GetFun(ch);
    fun:=DoFun(fun,ch);

    IF (Fun=Enter) AND (len(cy-1)>1) AND (character(cy-1,1)='/') THEN
      DoSlash(Fun);

    IF cy>MaxLines THEN cy:=MaxLines;
    IF (Fun=InsertChar) OR (Fun=InsertMCI) THEN
    BEGIN
      IF cx<=len(cy) THEN  { Strip off trailing blanks if they don't have a color }
        WHILE (character(cy,len(cy))=' ') AND (Color(line[cy]^,len(cy))='0') AND (len(cy)>cx) DO
          LDelete(cy,len(cy),1);
      IF Fun=InsertMCI THEN
      BEGIN
        MakeString(Temp,^C,CurrentColor);
        Linsert(Temp,cy,cx);
        Reformat(cy,true);
        inc(cx);
      END;
      MakeString(Temp,ch,CurrentColor);
      Linsert(Temp,cy,cx);         { Insert it                               }
      Reformat(cy,true);
      inc(cx);                     { move cursor right                       }
    END;
    IF cy>ViewBottom THEN          { "Scroll" the viewport down if needed    }
    BEGIN
      ViewTop:=cy-3;
      ViewBottom:=ViewTop+WindowHeight;
      IF ViewBottom>MaxLines THEN
      BEGIN
        ViewBottom:=MaxLines;
        ViewTop:=ViewBottom-WindowHeight;
      END;
    END;
    IF cy<ViewTop THEN             { "Scroll" the viewport up if needed      }
    BEGIN
      ViewBottom:=cy+3;
      ViewTop:=ViewBottom-WindowHeight;
      IF ViewTop<1 THEN
      BEGIN
        ViewTop:=1;
        ViewBottom:=ViewTop+WindowHeight;
      END;
    END;
    Drain;
    IF not KeyPressed THEN
      redisplay;                    { Redisplay Everything that has changed   }
  UNTIL (fun IN [AbortPost,ExitAndSave,NormalExit,QuietExitAndSave]);
  ReDisplay; { In case there are still keystrokes in the buffer [macro] }
  EditText:=Fun;
END;

PROCEDURE MakeFile(i:integer; title:string);
VAR t:text;
BEGIN
  IF NOT InDos THEN
  BEGIN
    assign(t,'RESULT.ED');
    rewrite(t);
    writeln(t,i);
    writeln(t,title);
    close(t);
  END;
END;


VAR
  Result : edfun;                { The Result of the Visual Edit }
  ReturnCode : integer;          { The number returned in RESULT.ED }

BEGIN { Main }
{$IFDEF OVERLAY}
  OvrInit('WWIVEdit.OVR');                                     Drain;
{$ENDIF}
  Initialize;                                                  Drain;
{$IFDEF DIRECTVIDEO}
  Translate := FALSE;
{$ENDIF}
  IF NoColor OR ForceAnsi THEN
    Translate:=TRUE;
  FindTitle(Title,Destination);  { Find title & Destination }  Drain;
  InitInfo;                                                    Drain;
  clrscr;                        { Clear the Screen }
  ReadInputFile(0,Filename);     { Read in the Input file }
  ShowHeader;                    { Show the message header }
  Redisplay;                     { Show the file - If one was read it }
  REPEAT
    ansic(CurrentColor);
    gotoxy(cx,cy+WindowTop-ViewTop); { Put the cursor in the right position }
    result := EditText;              { Do a visual Edit and get the result  }
  UNTIL Done(Result);                { True it the user saves or aborts     }
  IF Result=AbortPost THEN ClrScr;   { If the Sysop aborts it with ALT-A then clear the screen }
  IF Result = QuietExitAndSave THEN
    StatusLine1('');
  ReturnCode:=0;
  IF Result IN [ExitAndSave,QuietExitAndSave] THEN
  BEGIN
    WriteOutputFile(ReturnCode);
    MakeFile(Returncode, Title);
  END;
  nl;
  ansic('0'); clreol;
  SaveInfo;
END.  { Main }